home *** CD-ROM | disk | FTP | other *** search
- /*
- Ask for
- Data file, columns a.dat,1,2
- Equation sin(a*x)+x^2+b+c*x^3
- Initial values for a,b,c,...
- Output file name
- Write out results, fit, gle file.
- */
- #include "all.h"
- #include <math.h>
- #include <time.h>
- int load_data(char *s, int c1, int c2);
- #ifdef unix
- #define VAXC 1
- #endif
- #ifdef VAXC
- #ifndef unix
- #define unlink delete
- #endif
- #define farfree free
- #define farmalloc malloc
- #else
- #include <alloc.h>
- #endif
- typedef double real;
-
- int stringlower(char *s);
- int build_equation(char *expr, double pms[], int naz);
- int stripspace(char *ss);
- int var_find_az(int v_idx[],int *naz);
- int v_eval(double *v);
- /*---------------------------------------------------------------------------*/
- char outfile[255],inputfile[255];
- double anstol=1e-4;
- char equation[255];
- int pnt_alloc(int size);
- int col1,col2;
- double xmin,xmax;
- int gle_debug=0;
- #define dbg if (gle_debug>0)
- extern char file_name[];
- main()
- {
- char eqn[200],buff[200],myfile[200],lastone[200];
- char lastdat[200];
- int c1,c2;
- char *s1,*s2;
-
- lastone_get(lastone,lastdat);
- printf("Input data file (x and y columns optional) [%s] ? ",lastdat);
- gets(myfile);
- if (strlen(myfile)==0) strcpy(myfile,lastdat);
- strcpy(lastdat,myfile);
- s1 = strchr(myfile,',');
- c1 = 1; c2 = 2;
- if (s1!=NULL) {
- s2 = strchr(s1+1,',');
- c1 = atoi(s1+1);
- if (s2!=NULL) c2 = atoi(s2+1);
- if (c1==0 || c2==0) printf("Expecting filename.dat,xcol,ycol\n");
- *s1 = 0;
- }
- printf("Loading data from file, %s, xcolumn=%d, ycolumn=%d\n",myfile,c1,c2);
- col1 = c1; col2 = c2; strcpy(inputfile,myfile);
- load_data(myfile,c1,c2);
- printf("Valid operators: +, -, *, /, ^ (power) \n");
- printf("Valid functions:\n");
- printf("\t abs(), atn(), cos(), exp(), fix(), int()\n");
- printf("\t log(), log10(), not(), rnd(), sgn(), sin()\n");
- printf("\t sqr(), sqrt(), tan()\n");
- printf("\n Enter a function of 'x' using constants 'a'...'z' \n");
- printf(" e.g.\t a + b*x (standard linear least squares fit) \n");
- printf(" \t sin(x)*a+b \n");
- printf(" \t a + b*x + c*x^2 + d*x^3 \n");
- printf(" \t log(a*x)+(b+x)*c+a \n");
- printf("\nEquation [%s]? ",lastone);
- gets(eqn);
- if (strlen(eqn)==0) strcpy(eqn,lastone);
- strcpy(lastone,eqn);
-
- stripspace(eqn);
- strcpy(buff,myfile);
- s1 = strchr(buff,'.');
- if (s1!=NULL) *s1 = 0;
- strcat(buff,".gle");
-
- printf("Output file name to write gle file [%s] ?",buff); gets(outfile);
- if (strlen(outfile)==0) strcpy(outfile,buff);
- printf("Precision of fit required, [1e-4] ?"); gets(buff);
- anstol = atof(buff);
- if (anstol==0) anstol = 1e-4;
- strcpy(equation,eqn);
- lastone_save(eqn,lastdat);
- v_polish(eqn);
- dofit();
- }
- /*---------------------------------------------------------------------------*/
- int xyz_alloc;
- double *pntx;
- double *pnty;
- FILE *fp;
- int nxy;
- long npnts;
- pnt_alloc(int size)
- {
- void *d,*dd;
- if (size+10<xyz_alloc) return;
- size = size*2;
- d = farmalloc(size*sizeof(double));
- dd = farmalloc(size*sizeof(double));
- if (dd==NULL) printf("Unable to allocate storage for data %d\n",size*sizeof(double));
- if (d==NULL) printf("Unable to allocate storage for data %d\n",size*sizeof(double));
- if (d==NULL || dd==NULL) exit(1);
- if (xyz_alloc>0) memcpy(d,pntx,xyz_alloc*sizeof(double));
- if (xyz_alloc>0) memcpy(dd,pnty,xyz_alloc*sizeof(double));
- farfree(pntx); farfree(pnty);
- pnty = dd;
- pntx = d;
- xyz_alloc = size;
- }
- static char buff[2001];
- load_data(char *fname,int c1, int c2)
- {
- double v;
- char *s;
- FILE *df;
- int i,nd,nc,gotx,goty;
- int done_err;
- done_err = false;
- xmin = 10e10;
- xmax = -10e10;
- pnt_alloc(30);
-
- df = fopen(fname,"r");
- if (df==NULL) {
- printf("Unable to open data file %s \n",fname);
- exit(1);
- }
- nd = 0;
- for (;!feof(df);) {
- if (fgets(buff,2000,df)!=NULL) {
- if (strchr(buff,'!')!=NULL) *strchr(buff,'!') = 0;
- gotx = goty = false;
- s = strtok(buff," \t\n,");
- for (nc=1;s!=NULL;nc++) {
- v = atof(s);
- pnt_alloc(nd);
- if (isdigit(*s) || *s=='-' || *s=='+' || *s=='.') {
- if (nc==c1) {pntx[nd] = v; gotx = true;}
- if (nc==c2) {pnty[nd] = v; goty = true;}
- } else if (*s != '*') gprint("Not a number {%s} \n",s);
- s = strtok(NULL," \t\n,");
- }
- if (gotx && goty) {
- if (pntx[nd]>xmax) xmax = pntx[nd];
- if (pntx[nd]<xmin) xmin = pntx[nd];
- nd++;
- }
- }
- }
- fclose(df);
- nxy = nd;
- }
- /*---------------------------------------------------------------------------*/
- int v_idx[26], naz;
- long cpcode[200];
- v_polish(char *exp)
- {
- int cp,vtype,vidx,ddok,ssok;
- int plen,i;
- vtype = 1;
-
- for (i=0;i<26;i++) v_idx[i] = -1;
- polish(exp,(char *) cpcode,&plen,&vtype);
- var_find_az(v_idx,&naz);
- naz = 1;
- for (i=0;i<'x'-'a'; i++) {
- if (v_idx[i]>0) naz = i+1;
- }
- }
-
- double evalfn(double x,double p[]);
- double myfunc(double p[]);
- int powell(double p[],double **xi, int n,double ftol, int *iter,
- double *fret, double (*func)());
-
-
- double **matrix(int a, int b, int c, int d);
- static double pms[28];
- double rr_fit;
- dofit()
- {
- FILE *fp;
- static double **xi;
- int i,j;
- int niter=0;
- double fret=0;
-
- xi = matrix(1,naz,1,naz);
- for (i=1;i<=naz;i++) for (j=1;j<=naz;j++) xi[i][j] = 0;
- for (i=1;i<=naz;i++) xi[i][i] = 1;
- for (i=1;i<=naz;i++) {
- printf("Initial value for constant %c [1.0] ? ",i+'a'-1); gets(buff);
- if (strlen(buff)==0) strcpy(buff,"1");
- pms[i] = atof(buff);
- }
- powell(pms,xi,naz,anstol,&niter,&fret,myfunc);
- for (i=1;i<=naz;i++) printf("%c = %g ",i+'a'-1,pms[i]);
- printf("\n");
-
- build_equation(equation,pms,naz);
- stringlower(equation);
- printf("%d Iterations, sum of squares divided by nvalues, %g\n",niter,(double) fret);
- test_fit();
- printf("y = %s\n",equation);
-
- fp = fopen(outfile,"w");
- fprintf(fp,"size 24 18\n");
- fprintf(fp,"begin graph\n");
- fprintf(fp,"\tsize 24 18\n");
- fprintf(fp,"\ttitle \"y = %s, r^2 = %4.2f%%\" hei .4\n",equation,rr_fit);
- fprintf(fp,"\tdata %s d1=c%d,c%d \n",inputfile,col1,col2);
- fprintf(fp,"\td1 marker dot \n");
- fprintf(fp,"\tlet d2 = %s from %g to %g step %g \n",equation,xmin,xmax,(xmax-xmin)/100.0);
- fprintf(fp,"\td2 line \n");
- fprintf(fp,"end graph\n");
- fclose(fp);
- }
- test_fit()
- {
- int i,j;
- static int count;
- double v,sumy,sumy2,sumfy,sumfy2,meany,meanfy,rr,yy,fyy,sum1,sum2
- ,sum3,y,fy;
-
- sumy = sumy2 = sumfy = sumfy2 = 0;
- for (i=0;i<nxy;i++) {
- var_set(v_idx['x'-'a'],pntx[i]);
- v_eval(&v);
- sumfy = sumfy + v;
- sumy = sumy + pnty[i];
- }
- if (nxy==0) printf("No data points \n");
- meany = sumy/nxy;
- meanfy = sumfy/nxy;
-
- sum1 = 0; sum2 = 0; sum3 = 0;
- for (i=0;i<nxy;i++) {
- var_set(v_idx['x'-'a'],pntx[i]);
- v_eval(&fy);
- y = pnty[i];
- fyy = v-meanfy;
- yy = pnty[i]-meany;
- sum1 = sum1 + (y-fy)*(y-fy);
- sum2 = sum2 + (y-meany)*(y-meany);
- }
-
- rr = 1- (sum1/sum2);
- rr = 100*rr;
- printf("r^2 = %4.2f%%\n",rr);
- rr_fit = rr;
- /* r^2=100*( 1 - (sum of (y-yf)^2)/(sum of (y-ymean)^2) ) */
- }
- double myfunc(double p[])
- {
- int i,j;
- static int count;
- double tot=0,v;
- for (j=0;j<naz;j++) {
- if (v_idx[j]>=0) var_set(v_idx[j],p[j+1]);
- }
- for (i=0;i<nxy;i++) {
- var_set(v_idx['x'-'a'],pntx[i]);
- v_eval(&v);
- tot = tot + pow(fabs(pnty[i] - v),2);
- }
- if (nxy==0) printf("No data points \n");
- tot = tot/nxy;
- if (count/20==count/20.0) {
- printf("%d evaluations, ",count);
- for (i=1;i<=naz;i++) {
- printf("%g ",pms[i]);
- }
- printf(", fit = %g \n",tot);
- }
- count++;
- /* printf("Evaluate fit = %g\n",tot); */
- return tot;
- }
- v_eval(double *v)
- {
- int cp,vtype,vidx,ddok,ssok,j;
- char outstr[30];
- vtype = 1;
- cp = 0;
- eval(cpcode,&cp,v,outstr,&vtype);
- }
- gle_abort(char *s)
- {
- printf("Abort {%s} \n",s);
- exit(1);
- }
- getch(){}
- stripspace(char *ss)
- {
- char *s=ss;
- for (;*s != 0;s++) {
- if (*s != ' ') *ss++ = *s;
- }
- *ss++ = 0;
- }
- build_equation(char *expr, double pms[], int naz)
- {
- static char inbuff[200];
- static char *tk[500];
- static char tkbuff[500],answer[300];
- static int ntk,ct,i,c;
- char *space_str=" ";
- static char buff[50];
- if (tk[400]==NULL) for (i=0;i<500;i++) tk[i] = space_str;
- answer[0] = 0;
- ntk = 0;
- token_norm();
- token(expr,tk,&ntk,tkbuff);
- token_space();
- for (ct=1; ct<=ntk; ct++) {
- if (strlen(tk[ct])==1) {
- c = *tk[ct] - 'A';
- if (c>=0 && c<23) {
- sprintf(buff,"%g",pms[c+1]);
- strcat(answer,buff);
- continue;
- }
- }
- if (*tk[ct] != ' ') strcat(answer,tk[ct]);
- }
- strcpy(expr,answer);
- }
- stringlower(char *s)
- {
- for (;*s != 0;s++) *s = tolower(*s);
- }
-
- /* dummy routines for eval and polish */
- g_get_type(){}
- g_get_xy(){}
- g_measure(){}
- tex_xend(){}
- graph_xgraph(){}
- tex_yend(){}
- graph_ygraph(){}
- pass_marker(){}
- pass_font(){}
- pass_color(){}
-
- lastone_save(char *s,char *sdat)
- {
- FILE *f;
- unlink("fitls.eqn");
- f = fopen("fitls.eqn","w");
- if (f==NULL) {printf("Couldn't save eqn in FITLS.EQN\n"); return;}
- fprintf(f,"%s\n",s);
- fprintf(f,"%s\n",sdat);
- fclose(f);
- }
- lastone_get(char *s, char *sdat)
- {
- FILE *f;
- char *ss;
- f = fopen("fitls.eqn","r");
- if (f==NULL) goto dflt;
- fgets(s,200,f);
- ss = strchr(s,'\n');
- if (ss!=NULL) *ss = 0;
- if (fgets(sdat,200,f)==NULL) goto dflt2;
- ss = strchr(sdat,'\n');
- if (ss!=NULL) *ss = 0;
- fclose(f);
- if (strlen(sdat)==0) goto dflt2;
- return;
- dflt:
- strcpy(s,"a+b*x");
- dflt2:
- strcpy(sdat,"test.dat,1,2");
- return;
- }
-